home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Deutsche Edition 1
/
Deutsche Edition 1.iso
/
amok
/
amok_lha
/
amok13.lha
/
Rows
/
Rows.mod
< prev
next >
Wrap
Text File
|
1993-08-15
|
5KB
|
182 lines
(**********************************************************************
:Program. Rows.mod
:Contents. generic data type: variable length arrays
:Author. Nicolas Benezan [bne]
:Address. Postwiesenstr. 2, D7000 Stuttgart 60
:Phone. 711/333679
:Copyright. Public Domain
:Language. Modula-2
:Translator. M2Amiga AMSoft V3.2d
:Imports. TaskMemory [bne]
:History. V1.0f [bne] 27.Jan.1989
:Update. allocation procedures added [bne] 19.Jan.1989
:Bugs. this version cannot handle Rows of Rows correctly
**********************************************************************)
IMPLEMENTATION MODULE Rows;
FROM SYSTEM IMPORT ADDRESS,BYTE,ADR;
FROM TaskMemory IMPORT Allocate,Deallocate;
FROM Arts IMPORT Assert;
FROM Exec IMPORT CopyMem;
TYPE Row=POINTER TO Header;
Header=RECORD
MaxIndex:LONGINT;
ByteSize:CARDINAL;
AlignedSize:LONGINT;
Buffer:ADDRESS;
END;
CONST Offset=LONGINT(SIZE(Header));
Undefined="Rows: undefined Row";
IllegalSize="Rows: Size of data too big";
IllegalIndex="Rows: Index range violation";
ImportCorrupt="Rows: Import()ed corrupt Row";
(**)
(* Word alignement *)
(**)
PROCEDURE Align(Bytes:LONGINT):LONGINT;
BEGIN
IF ODD(Bytes) THEN
RETURN Bytes+1;
ELSE
RETURN Bytes;
END;
END Align;
(**)
(* aligns size to word boundaries if neccessary *)
(**)
PROCEDURE ActualSize(ByteSize:CARDINAL):LONGINT;
BEGIN
IF ByteSize>2 THEN
RETURN Align(ByteSize);
ELSE
RETURN LONGINT(ByteSize);
END;
END ActualSize;
PROCEDURE Dim(VAR row:Row;NumElements:LONGINT;
SizeOfElements:CARDINAL):BOOLEAN;
VAR Size:LONGINT;
BEGIN
Size:=ActualSize(SizeOfElements);
RowsAllocProc(row,Align(NumElements*Size)+Align(Offset));
IF row#NIL THEN
WITH row^ DO
MaxIndex:=NumElements-1;
ByteSize:=SizeOfElements;
AlignedSize:=Size;
Buffer:=Align(LONGINT(row)+Offset);
END;
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END Dim;
PROCEDURE Discard(VAR row:Row);
BEGIN
IF row#NIL THEN
RowsDeallocProc(row);
END;
END Discard;
(**)
(* Checks wether index is valid for read or write operation *)
(**)
PROCEDURE TestIndex(Index,MaxIndex:LONGINT);
BEGIN
Assert((Index>=0)AND(Index<=MaxIndex),ADR(IllegalIndex));
END TestIndex;
PROCEDURE Read(row:Row;Index:LONGINT;VAR Data:ARRAY OF BYTE);
BEGIN
Assert(row#NIL,ADR(Undefined));
WITH row^ DO
TestIndex(Index,MaxIndex);
Assert(CARDINAL(HIGH(Data))<ByteSize,ADR(IllegalSize));
CopyMem(LONGINT(Buffer)+Index*AlignedSize,ADR(Data),HIGH(Data)+1);
END;
END Read;
PROCEDURE Write(row:Row;Index:LONGINT;Data:ARRAY OF BYTE);
BEGIN
Assert(row#NIL,ADR(Undefined));
WITH row^ DO
TestIndex(Index,MaxIndex);
Assert(CARDINAL(HIGH(Data))<ByteSize,ADR(IllegalSize));
CopyMem(ADR(Data),LONGINT(Buffer)+Index*AlignedSize,HIGH(Data)+1);
END;
END Write;
PROCEDURE High(row:Row):LONGINT;
BEGIN
RETURN row^.MaxIndex;
END High;
PROCEDURE CompSize(row:Row):CARDINAL;
BEGIN
RETURN row^.ByteSize;
END CompSize;
PROCEDURE Export(row:Row;VAR Base:ADDRESS;VAR Size:LONGINT);
BEGIN
IF row#NIL THEN
WITH row^ DO
Base:=Buffer;
Size:=AlignedSize*(MaxIndex+1);
END;
ELSE
Size:=0;
END;
END Export;
PROCEDURE Import(VAR row:Row;NumElements:LONGINT;
SizeOfElements:CARDINAL;Base:ADDRESS;Size:LONGINT);
BEGIN
Assert(row#NIL,ADR(Undefined));
WITH row^ DO
Assert((NumElements=0)OR(ByteSize=0),ADR(IllegalSize));
WITH row^ DO
MaxIndex:=NumElements-1;
ByteSize:=SizeOfElements;
AlignedSize:=ActualSize(SizeOfElements);
IF AlignedSize#LONGINT(ByteSize) THEN (* if size alignment was necessary *)
Assert(Base=Align(Base),ADR(ImportCorrupt)); (* base address alignment is, too *)
END;
Buffer:=Base;
Assert(Size=AlignedSize*LONGINT(NumElements),ADR(ImportCorrupt)); (* Check buffer size *)
END;
END;
END Import;
PROCEDURE Assign(Source:Row;VAR Destination:Row):BOOLEAN;
VAR Base:ADDRESS;
Size:LONGINT;
BEGIN
Assert(Source#NIL,ADR(Undefined));
Export(Source,Base,Size);
IF Destination#NIL THEN
Assert((Source^.ByteSize=Destination^.ByteSize)
AND(Source^.MaxIndex=Destination^.MaxIndex),ADR(IllegalSize));
ELSE
RowsAllocProc(Destination,Size);
END;
IF Destination#NIL THEN
CopyMem(Source,Destination,Size);
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END Assign;
BEGIN
RowsAllocProc:=Allocate;
RowsDeallocProc:=Deallocate;
END Rows.